VERSION = 3.00)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 cmdclosePixels Close buttonClass1 commandbuttoncmdclose!Arial, 0, 9, 5, 15, 12, 13, 3, 0  tbrbackcolor5!Arial, 0, 9, 5, 15, 12, 32, 3, 0  behindscenesPixelsClass1 commandbutton behindscenespPROCEDURE Click IF THISFORM.HelpContextID > 0 HELP ID (THISFORM.HelpContextID) ELSE HELP ENDIF ENDPROC 1 (%U;%%$I4$UTHISFORM HELPCONTEXTIDClick,1AqA1e) c_solutionsPixels%common solutions sample functionalityClass7 commandbutton{Width = 104 Height = 24 BorderWidth = 1 BackColor = 192,192,192 skiptable = enabledisableoninit = .T. Name = "vcr" vcrvcr3PROCEDURE Click IF TYPE("THISFORM.Parent") = "O" THISFORMSET.Release ELSE THISFORM.Release ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lnChoice #DEFINE CR CHR(13) DO CASE CASE nError = 1545 && Uncommitted changes *------------------------------------ #DEFINE MSG1_LOC "Do you want to save your changes?" #DEFINE MSG2_LOC "Uncommitted Changes" lnChoice = MESSAGEBOX(MSG1_LOC, 4+48+0, MSG2_LOC) DO CASE CASE lnChoice = 6 && yes =TABLEUPDATE(.T., .T.) CASE lnChoice = 7 && no =TABLEREVERT(.T.) ENDCASE OTHERWISE && Unanticipated error *-------------------------------------- #DEFINE NUM_LOC "Error Number: " #DEFINE PROG_LOC "Program: " #DEFINE CAP_LOC "ERROR" lcMsg = NUM_LOC + ALLTRIM(STR(nError)) + CR + CR + ; MESSAGE()+ CR + CR + PROG_LOC + PROGRAM(1) lnChoice = MESSAGEBOX(lcMsg, 2+48+512, CAP_LOC) DO CASE CASE lnChoice = 3 &&Abort CANCEL CASE lnChoice = 4 &&Retry RETRY CASE lnChoice = 5 &&Ignore RETURN ENDCASE ENDCASE ENDPROC  commandbuttonPixelsClasstoolbar tbrbackcolorcmdWhite1j QQ%UT9aT9C^'C ForeColorC^9+C BackColor9LABEL9T9-U ACTIVEFORM LOCKSCREEN BACKCOLORSETALLClick,1q2)QPROCEDURE Click _SCREEN.ActiveForm.LockScreen = .T. _SCREEN.ActiveForm.BackColor = RGB(255,255,255) _SCREEN.ActiveForm.SetAll("ForeColor", RGB(0,0,0)) _SCREEN.ActiveForm.SetAll("BackColor", _SCREEN.ActiveForm.BackColor, "LABEL") _SCREEN.ActiveForm.LockScreen = .F. ENDPROC xTop = 6 Left = 75 Height = 23 Width = 24 Picture = menus\white.bmp Caption = "" Default = .F. Name = "cmdWhite"  tbrbackcolor commandbutton commandbuttonkPROCEDURE Click _SCREEN.ActiveForm.LockScreen = .T. _SCREEN.ActiveForm.BackColor = RGB(0,0,255) _SCREEN.ActiveForm.SetAll("ForeColor", RGB(255,255,255), "LABEL") _SCREEN.ActiveForm.SetAll("BackColor", _SCREEN.ActiveForm.BackColor, "LABEL") _SCREEN.ActiveForm.SetAll("ForeColor", RGB(255,255,255), "CHECKBOX") _SCREEN.ActiveForm.LockScreen = .F. ENDPROC  tbrbackcolorcmdBluecmdGreen formmarginPixelsClassshape formmarginVTop = 64 Left = 0 Height = 253 Width = 10 BackColor = 255,0,255 Name = "Shape5" shape %%D4UT9aT9C^/C ForeColorC^LABEL9+C BackColor9LABEL92C ForeColorC^CHECKBOX9T9-U ACTIVEFORM LOCKSCREEN BACKCOLORSETALLClick,1!2`)vTop = 6 Left = 52 Height = 23 Width = 24 Picture = menus\blue.bmp Caption = "" Default = .F. Name = "cmdBlue"  commandbutton commandbutton D%PgaUT-UTHISVISIBLEDestroy,11%) commandbuttoncmdPrior commandbutton commandbuttoncmdNextvcr commandbutton commandbuttonvcr tbrbackcolor commandbutton commandbutton tbrbackcolorcmdRedHeight = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Cancel = .T. Caption = "Close" Name = "cmdclose" PROCEDURE Click _SCREEN.ActiveForm.LockScreen = .T. _SCREEN.ActiveForm.BackColor = RGB(0,255,0) _SCREEN.ActiveForm.SetAll("ForeColor", RGB(0,0,0)) _SCREEN.ActiveForm.SetAll("BackColor", _SCREEN.ActiveForm.BackColor, "LABEL") _SCREEN.ActiveForm.LockScreen = .F. ENDPROC xTop = 6 Left = 29 Height = 23 Width = 24 Picture = menus\green.bmp Caption = "" Default = .F. Name = "cmdGreen" 1gHeight = 23 Width = 25 Picture = bts.bmp Caption = "" ToolTipText = "Help" Name = "behindscenes"  commandbutton container datachecker..\classes\checker.bmp..\classes\checker.bmpmanages conflicts1 cmdBottom datachecker solution.vcxcustom Datachecker1vcrvcr containerClasscustom6kPROCEDURE Click _SCREEN.ActiveForm.LockScreen = .T. _SCREEN.ActiveForm.BackColor = RGB(255,0,0) _SCREEN.ActiveForm.SetAll("ForeColor", RGB(255,255,255), "LABEL") _SCREEN.ActiveForm.SetAll("BackColor", _SCREEN.ActiveForm.BackColor, "LABEL") _SCREEN.ActiveForm.SetAll("ForeColor", RGB(255,255,255), "CHECKBOX") _SCREEN.ActiveForm.LockScreen = .F. ENDPROC sTop = 6 Left = 6 Height = 23 Width = 24 Picture = menus\red.bmp Caption = "" Default = .F. Name = "cmdRed"  commandbutton commandbuttonTop = 0 Left = 26 Height = 24 Width = 26 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = "<" TabIndex = 2 ToolTipText = "Prior" Name = "cmdPrior" generic vcr buttons0PROCEDURE Destroy THIS.Visible = .F. ENDPROC rCaption = "Form BackColor" Height = 32 Left = 0 Top = 0 Width = 103 ControlBox = .F. Name = "tbrbackcolor" toolbar`cpoint csep cdate ccurrency cdirectory ctalk coldhelp chelpfile cdeleted getdirectory custom c_solutionsHeight = 18 Width = 25 centerform = .T. fixedformborder = .T. cpoint = csep = cdate = ccurrency = cdirectory = ctalk = OFF coldhelp = chelpfile = foxhelp.chm cdeleted = coldpath = Name = "c_solutions" custom frmsolutionPixelsClassform frmsolutionj QQ%UT9aT9C^'C ForeColorC^9+C BackColor9LABEL9T9-U ACTIVEFORM LOCKSCREEN BACKCOLORSETALLClick,1q2 )Q %%D4UT9aT9C^/C ForeColorC^LABEL9+C BackColor9LABEL92C ForeColorC^CHECKBOX9T9-U ACTIVEFORM LOCKSCREEN BACKCOLORSETALLClick,1!2`)JArial, 0, 9, 5, 15, 12, 32, 3, 0 MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 9Top = 165 Left = 265 TabIndex = 4 Name = "Cmdclose1"  frmsolution Cmdclose1 commandbutton solution.vcxcmdcloseLabel4customAutoSize = .T. FontName = "Tahoma" FontSize = 8 Caption = "Instructions" Height = 15 Left = 16 Top = 5 Width = 59 TabIndex = 0 Style = 3 Name = "Label4"  frmsolutionClasslabellabel frmsolutioncmdTopDTop = 6 Left = 44 Height = 15 Width = 23 Name = "Datachecker1" (Courier New, 1, 11, 9, 17, 12, 11, 5, 0 Pixelsvcr`PROCEDURE Init IF fontmetric(1, 'MS Sans Serif', 8, '') # 13 OR ; fontmetric(4, 'MS Sans Serif', 8, '') # 2 OR ; fontmetric(6, 'MS Sans Serif', 8, '') # 5 OR ; fontmetric(7, 'MS Sans Serif', 8, '') # 11 this.top = thisform.shape2.top + 7 this.left = thisform.shape2.left + 7 this.width = thisform.shape2.width - 14 ENDIF ENDPROC Label1labellabel frmsolutionShape2/Height = 15 Width = 23 Name = "datachecker"  resizableClasscustom resizablecustomskiptable The table to move the record pointer in . enabledisableoninit *recordpointermoved Method called each time the record pointer is moved, basically providing a new event for the class. *enabledisablebuttons *beforerecordpointermoved PixelsPixels commandbutton datacheckerTop = 0 Left = 0 Height = 24 Width = 26 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = "|<" TabIndex = 1 ToolTipText = "Top" Name = "cmdTop"  commandbuttoninitialresize Is this the first time the controls are being adjusted? initialformheight initialformwidth repositionlist resizelist *adjustcontrols call from resize event of a form to adjust the placement and size of contained objects. *addtoarray *setsize *loopthroughcontrols *reset Resets the Timer control so that it starts counting from 0. ^acontrolstats[1,5] *setposition qHeight = 19 Width = 27 initialresize = .T. initialformheight = 0 initialformwidth = 0 repositionlist = Commandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image Spinner resizelist = Commandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image Spinner Name = "resizable" zinitialresize initialformheight initialformwidth addtoarray setsize loopthroughcontrols acontrolstats setposition *handlerecord compares the current value, old value, and original value of each field, displaying a messagebox if a change or conflict is detected. *string returns type 'c' equivalent of passed value *verifychanges Prompts a user to save all changes made to a table or record. *verifyeachchange Prompts a user to confirm each change he or she made. *checkconflicts Notifies a user if someone else has changed the data in the table after he or she began editing a record. Top = 0 Left = 52 Height = 24 Width = 26 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = ">" TabIndex = 3 ToolTipText = "Next" Name = "cmdNext" PROCEDURE Error Parameters nError, cMethod, nLine This.Parent.Error(nError, cMethod, nLine) ENDPROC PROCEDURE Click THIS.Parent.BeforeRecordPointerMoved GO TOP THIS.Parent.RecordPointerMoved THIS.Parent.EnableDisableButtons ENDPROC FontName = "Tahoma" FontSize = 8 WordWrap = .T. BackStyle = 0 Caption = "Sample instructions" Height = 30 Left = 24 Top = 24 Width = 300 TabIndex = 0 Name = "Label1" shapeshape;Top = 165 Left = 9 TabIndex = 3 Name = "Behindscenes1" Top = 0 Left = 78 Height = 24 Width = 26 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = ">|" TabIndex = 4 ToolTipText = "Bottom" Name = "cmdBottom" mTop = 12 Left = 12 Height = 48 Width = 324 BackStyle = 0 SpecialEffect = 0 Style = 3 Name = "Shape2"  frmsolution Behindscenes1 commandbutton solution.vcx behindscenescustomPROCEDURE Error Parameters nError, cMethod, nLine This.Parent.Error(nError, cMethod, nLine) ENDPROC PROCEDURE Click THIS.Parent.BeforeRecordPointerMoved GO BOTTOM THIS.Parent.EnableDisableButtons THIS.Parent.RecordPointerMoved ENDPROC  %@ .U.4CUNERRORCMETHODNLINETHISPARENTERROR/ #6  UTHISPARENTBEFORERECORDPOINTERMOVEDENABLEDISABLEBUTTONSRECORDPOINTERMOVEDError,Click12R1]y)PROCEDURE Error Parameters nError, cMethod, nLine This.Parent.Error(nError, cMethod, nLine) ENDPROC PROCEDURE Click THIS.Parent.BeforeRecordPointerMoved SKIP -1 IF BOF() GO TOP ENDIF THIS.Parent.RecordPointerMoved THIS.Parent.EnableDisableButtons ENDPROC  %@ .U.4CUNERRORCMETHODNLINETHISPARENTERROR/ #)  UTHISPARENTBEFORERECORDPOINTERMOVEDRECORDPOINTERMOVEDENABLEDISABLEBUTTONSError,Click12R2]y)PROCEDURE Error Parameters nError, cMethod, nLine This.Parent.Error(nError, cMethod, nLine) ENDPROC PROCEDURE Click THIS.Parent.BeforeRecordPointerMoved SKIP 1 IF EOF() GO BOTTOM ENDIF THIS.Parent.RecordPointerMoved THIS.Parent.EnableDisableButtons ENDPROC  PROCEDURE adjustcontrols IF THIS.InitialResize THIS.LoopThroughControls("INITIALIZE_AND_ADJUST") THIS.InitialResize = .F. ELSE THIS.LoopThroughControls("ADJUST") ENDIF ENDPROC PROCEDURE addtoarray LPARAMETERS oControl nLen = ALEN(THIS.aControlStats,1) THIS.aControlStats[nLen,1] = oControl.Top / THIS.InitialFormHeight THIS.aControlStats[nLen,2] = oControl.Left / THIS.InitialFormWidth THIS.aControlStats[nLen,3] = oControl.Height / THIS.InitialFormHeight THIS.aControlStats[nLen,4] = oControl.Width / THIS.InitialFormWidth THIS.aControlStats[nLen,5] = IIF(TYPE("oControl.FontSize") = 'U', 0, oControl.FontSize) DIMENSION THIS.aControlStats[nLen+1, 5] ENDPROC PROCEDURE setsize LPARAMETERS oControl, nPos oControl.Width = THISFORM.Width * THIS.aControlStats[nPos,4] IF !oControl.Baseclass $ "Textbox Spinner" oControl.Height = THISFORM.Height * THIS.aControlStats[nPos,3] ENDIF ENDPROC PROCEDURE loopthroughcontrols LPARAMETERS cTask * Valid parameters for cTask are 'Initialize_And_Adjust' and 'Adjust' cTask = UPPER(cTask) nOldDecimal = SET("DECIMAL") SET DECIMAL TO 18 nPos = 0 THISFORM.LockScreen = .T. FOR m.i = 1 TO THISFORM.ControlCount oControl = THISFORM.Controls[m.i] nPos = nPos + 1 If cTask = 'INITIALIZE_AND_ADJUST' THIS.AddToArray(oControl) ENDIF IF oControl.Class$THIS.ResizeList THIS.SetSize(oControl, nPos) ENDIF IF oControl.Class$THIS.RepositionList THIS.SetPosition(oControl, nPos) ENDIF *A pageframe can contain only pages IF THISFORM.Controls[m.i].Baseclass$"Pageframe" *Loop through each page of the pageframe FOR m.j = 1 TO THISFORM.Controls[m.i].PageCount WITH THISFORM.Controls[m.i].pages[m.j] *loop through all the controls on the page FOR m.k = 1 TO .ControlCount nPos = nPos + 1 IF cTask = 'INITIALIZE_AND_ADJUST' THIS.AddToArray(.Controls[m.k]) ENDIF IF oControl.Class$THIS.ResizeList THIS.SetSize(oControl, nPos) ENDIF IF oControl.Class$THIS.RepositionList THIS.SetPosition(oControl, nPos) ENDIF ENDFOR ENDWITH ENDFOR ENDIF ENDFOR THISFORM.LockScreen = .F. SET DECIMAL TO nOldDecimal ENDPROC PROCEDURE reset * Call the reset method when you add a control to the form at runtime. THIS.InitialResize = .T. DIMENSION THIS.aControlStats[1,5] THIS.InitialFormHeight = THISFORM.Height THIS.InitialFormWidth = THISFORM.Width ENDPROC PROCEDURE setposition LPARAMETERS oControl, nPos oControl.Top = THISFORM.Height * THIS.aControlStats[nPos,1] oControl.Left = THISFORM.Width * THIS.aControlStats[nPos,2] ENDPROC PROCEDURE Init THIS.InitialFormHeight = THISFORM.Height THIS.InitialFormWidth = THISFORM.Width ENDPROC centerform If .T., Thisform.Autocenter is set to .T. fixedformborder If .T., borderstyle of the form is set to .T. cpoint old SET POINT TO setting csep Old SET SEPARATOR TO setting cdate Old SET DATE TO setting ccurrency Old SET CURRENCY TO setting cdirectory Stores the SET DEFAULT directory when the form was run and restores it after the form is closed. ctalk autosetdefault Whether or not to set the default directory in the Init of the class coldhelp original help file chelpfile Help file for the sample cdeleted coldpath lcalledbysolution *getdirectory *savehelp Saves the current help file setting. *restorehelp Restores the help file setting previously saved. *addtopath  %EaSU%C MS Sans Serif$ !C MS Sans Serif$ !C MS Sans Serif$ !C MS Sans Serif$  TTTUTHISTOPTHISFORMSHAPE2LEFTWIDTHInit,1d A2U)YTop = 125 Left = 309 Height = 18 Width = 25 centerform = .F. Name = "C_solutions1"  frmsolution C_solutions1 solution.vcx c_solutions2lsetffcpath csavesetpath crunpath *addtopath form %)_ GU.4CUNERRORCMETHODNLINETHISPARENTERRORH  H %C+'#6  UTHISPARENTBEFORERECORDPOINTERMOVEDRECORDPOINTERMOVEDENABLEDISABLEBUTTONSError,Click12QA2]y )DataSession = 2 Height = 197 Width = 348 DoCreate = .T. AutoCenter = .T. Caption = "Solutions" MaxButton = .F. csavesetpath = Name = "frmsolution"  DPROCEDURE recordpointermoved IF TYPE('_VFP.ActiveForm') = 'O' _VFP.ActiveForm.Refresh ENDIF ENDPROC PROCEDURE enabledisablebuttons LOCAL nRec, nTop, nBottom IF EOF() && Table empty or no records match a filter THIS.SetAll("Enabled", .F.) RETURN ENDIF nRec = RECNO() GO TOP nTop = RECNO() GO BOTTOM nBottom = RECNO() GO nRec DO CASE CASE nRec = nTop THIS.cmdTop.Enabled = .F. THIS.cmdPrior.Enabled = .F. THIS.cmdNext.Enabled = .T. THIS.cmdBottom.Enabled = .T. CASE nRec = nBottom THIS.cmdTop.Enabled = .T. THIS.cmdPrior.Enabled = .T. THIS.cmdNext.Enabled = .F. THIS.cmdBottom.Enabled = .F. OTHERWISE THIS.SetAll("Enabled", .T.) ENDCASE ENDPROC PROCEDURE beforerecordpointermoved IF !EMPTY(This.SkipTable) SELECT (This.SkipTable) ENDIF ENDPROC PROCEDURE Init IF THIS.EnableDisableOnInit THIS.EnableDisableButtons ENDIF ENDPROC PROCEDURE Error Parameters nError, cMethod, nLine #define NUM_LOC "Error Number: " #define PROG_LOC "Procedure: " #define MSG_LOC "Error Message: " #define CR_LOC CHR(13) #define SELTABLE_LOC "Select Table:" #define OPEN_LOC "Open" #define SAVE_LOC "Do you want to save your changes anyway?" #define CONFLICT_LOC "Unable to resolve data conflict." DO CASE CASE nError = 13 && Alias not found *----------------------------------------------------------- * If the user tries to move the record pointer when no * table is open or when an invalid SkipTable property has been * specified, prompt the user for a table to open. *----------------------------------------------------------- cNewTable = GETFILE('DBF', SELTABLE_LOC, OPEN_LOC) IF FILE(cNewTable) SELECT 0 USE (cNewTable) This.SkipTable = ALIAS() ELSE This.SkipTable = "" ENDIF CASE nError = 1585 *----------------------------------------------------------- * Update conflict handled by datachecker class. *----------------------------------------------------------- nConflictStatus = THIS.DataChecker1.CheckConflicts() IF nConflictStatus = 2 WAIT WINDOW CONFLICT_LOC ENDIF OTHERWISE *----------------------------------------------------------- * Display information about an unanticipated error. *----------------------------------------------------------- lcMsg = NUM_LOC + ALLTRIM(STR(nError)) + CR_LOC + CR_LOC + ; MSG_LOC + MESSAGE( )+ CR_LOC + CR_LOC + ; PROG_LOC + PROGRAM(1) lnAnswer = MESSAGEBOX(lcMsg, 2+48+512) DO CASE CASE lnAnswer = 3 &&Abort CANCEL CASE lnAnswer = 4 &&Retry RETRY OTHERWISE RETURN ENDCASE ENDCASE ENDPROC  %*` HU.4CUNERRORCMETHODNLINETHISPARENTERRORI  H %C(#)  UTHISPARENTBEFORERECORDPOINTERMOVEDRECORDPOINTERMOVEDENABLEDISABLEBUTTONSError,Click12QA2]y)$   %VtUF#%CTHISFORM.ParentbO- ? U THISFORMSETRELEASETHISFORM H#  JTC!Do you want to save your changes?4Uncommitted Changesx H  Caa  Ca2QTError Number: CCZC C CEC C  Program: CtTC2ERRORx HI ^  sX BUNERRORCMETHODNLINELNCHOICELCMSGClick,Error11A2q!AAAAAA2g() !PROCEDURE handlerecord *---------------------------------------------------------------* * This method is called from the CheckConflicts method and the * VerifyEachChange method. It loops through each field in the * current record and compares the current value with the value * stored in the table. If a value of 1 is passed to this method, * the method also compares the current value with the value in * the field before user made any edits. * * RETURNS NUMERIC VALUES: * 0 -- No Change Made to the Current Value * 1 -- Successfully Made User-Specified Change * 2 -- Unable to Make User-Specifed Change *---------------------------------------------------------------* LPARAMETERS lnScope *--Valid values for lnScope: * 0 - Only manage conflicts && default * 1 - Also prompt for changed values * Verify parameter IF TYPE("m.lnScope") != "N" m.lnScope = 0 ENDIF IF !BETWEEN(m.lnScope, 0, 1) #define WINDMSG_LOC "Invalid value passed to conflictmanager.handlerecord" WAIT WINDOW WINDMSG_LOC ENDIF * Declare constants & variables #define CR_LOC CHR(13) #define SAVE_LOC "Do you want to overwrite the current value with your change?" + CR_LOC + "(Choose 'Cancel' to restore the original value.)" #define CONFLICT_LOC "Data Conflict" #define VERIFY_LOC "Verify Changes" #define ORG_LOC "Original Value: " #define CUR_LOC "Current Value: " #define CHG_LOC "Your change: " #define MEMO_LOC " is a Memo field." #define FIELD_LOC "Field: " #define RECORD_LOC "Record Number: " #define VALCHG1_LOC "A value has been changed by another user." #define VALCHG2_LOC "A value has been changed." LOCAL lnChoice, lnField, lcField, luOldVal, luCurVal, luField, llMadeChange, llSuccess m.llMadeChange = .F. m.llSuccess = .T. * refresh current record in views before checking for conflicts IF CURSORGETPROP('SourceType') != 3 && not a local table =REFRESH() ENDIF * Check each field in the record for conflict or value change FOR m.lnField = 1 to FCOUNT() m.lnChoice = 0 m.lcField = FIELD(m.lnField) IF TYPE(m.lcField) = "G" LOOP && Can't check general fields ENDIF m.luOldVal = OLDVAL(m.lcField) m.luCurVal = CURVAL(m.lcField) DO CASE * -----< check for conflicts only >-------- CASE m.lnScope = 0 IF m.luOldVal != m.luCurVal m.llMadeChange = .T. m.lnChoice = MESSAGEBOX(VALCHG1_LOC + CR_LOC + FIELD_LOC + lcField + CR_LOC + ; RECORD_LOC + ALLTRIM(STR(RECNO())) + ; IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ; CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ; CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC + CR_LOC + m.lcField + MEMO_LOC) + ; CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, CONFLICT_LOC) ENDIF * -----< check for conflicts and verify all changes >-------- CASE m.lnScope = 1 && Verify all changes m.luField = EVAL(m.lcField) IF m.luOldVal != m.luField OR m.luCurVal != m.luField m.llMadeChange = .T. m.lnChoice = MESSAGEBOX(VALCHG2_LOC + CR_LOC + FIELD_LOC + m.lcField + CR_LOC + ; RECORD_LOC + ALLTRIM(STR(RECNO())) + ; IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ; CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ; CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC + CR_LOC + m.lcField + MEMO_LOC) + ; CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, VERIFY_LOC) ENDIF ENDCASE DO CASE CASE m.lnChoice = 7 && No, don't save changes REPLACE (m.lcField) WITH m.luCurVal CASE m.lnChoice = 2 && Cancel, restore original value REPLACE (m.lcField) WITH m.luOldVal ENDCASE ENDFOR IF m.llMadeChange m.llSuccess = TABLEUPDATE(.F., .T.) RETURN IIF(m.llSuccess, 1, 2) ELSE RETURN 0 ENDIF ENDPROC PROCEDURE string *---------------------------------------------------------------* * This method is called from the HandleRecord method. It * returns the character equivalent of the value passed in as a * parameter. If a memo field is passed in, a notice to this * effect is returned rather than the value in the memo field so * that potentially large amounts of text aren't displayed in the * messagebox. *---------------------------------------------------------------* LPARAMETERS luValue m.uType = TYPE('m.luValue') DO CASE CASE m.uType = 'C' RETURN ALLTRIM(m.luValue) CASE INLIST(m.uType, 'N', 'Y') RETURN ALLTRIM(STR(m.luValue)) CASE m.uType = 'D' RETURN DTOC(m.luValue) CASE m.uType = 'T' RETURN TTOC('m.luValue') CASE m.uType = 'L' RETURN IIF(m.luValue, '.T.', '.F.') CASE uType = 'M' RETURN 'Memo field' ENDCASE ENDPROC PROCEDURE verifychanges *---------------------------------------------------------------* * If any changes have been made to the table or record, prompt the * user to save the changes. If the user says 'yes,' all changes * are saved. Any changes made to the data by other users after * this user made the change and before the change was committed * will be lost. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made All User Changes * 2 -- Unable to Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* * Declare constants & variables #define SAVECHG_LOC 'Do you want to save your changes?' #define SAVECHG2_LOC 'Save Changes' #define NOBUFF_LOC2 'Data buffering is not enabled.' LOCAL lnChoice, llMadeChange, lnSuccess m.llMadeChange = .F. m.lnSuccess = 0 * If the user has changed anything, prompt to save or discard changes DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) m.llMadeChange = .T. ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering IF GETNEXTMODIFIED(0) > 0 m.llMadeChange = .T. ENDIF OTHERWISE WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE IF m.llMadeChange m.lnChoice = MESSAGEBOX(SAVECHG_LOC, 4+32, SAVECHG2_LOC) IF m.lnChoice = 6 && Yes m.lnSuccess = IIF(TABLEUPDATE(.T.,.T.), 1, 2) ELSE =TABLEREVERT(.T.) ENDIF ENDIF RETURN m.lnSuccess ENDPROC PROCEDURE verifyeachchange *-------------------------------------------------------------------- * If any changes have been made to the table or record, for each * change, display the old value and the new value, prompting the * user to save or discard the change. Conflict management is also * included in the HandleRecord method. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made User-Specified Changes * 2 -- Unable to Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* #define NOBUFF_LOC3 'Data buffering is not enabled.' LOCAL lnSuccess, lnRec m.lnSuccess = 0 DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) && Data has changed m.lnSuccess = THIS.HandleRecord(1) ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering m.lnRec = GETNEXTMODIFIED(0) DO WHILE m.lnRec > 0 GO m.lnRec m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(1), 2) m.lnRec = GETNEXTMODIFIED(m.lnRec) ENDDO OTHERWISE && No Buffering WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE RETURN m.lnSuccess ENDPROC PROCEDURE checkconflicts *---------------------------------------------------------------* * Checks to see whether another user has changed the value * stored in a table. If so, calls HandleRecord to display * the new value and allow the user to decide what to do. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made User-Specified Changes * 2 -- Unable to Make Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* #define NOBUFF1_LOC 'Data buffering is not enabled.' LOCAL lnSuccess, llnRec m.lnSuccess = 0 DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) && Data has changed m.lnSuccess = THIS.HandleRecord(0) ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering m.llnRec = GETNEXTMODIFIED(0) DO WHILE m.llnRec > 0 GO m.llnRec m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(0), 2) m.llnRec = GETNEXTMODIFIED(m.llnRec) ENDDO OTHERWISE && no buffering WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE RETURN m.lnSuccess ENDPROC  6   %C iU%ClcFilebLn%CTHISFORMbOPTC]jTC] BCULCFILETHISFORMw%%CCfCCHELPvf >TCHELPv%C C0 pG(UTHIS CHELPFILECOLDHELPW%C P%C04G(LG(CUTHISCOLDHELPTCTCCPATHv%C HU C;tB CC;B CCC>RB%C G)(-G)(CCR;;6UTCPATHLCPATH LCSETPATHDTSET TALK &cMacro TSET DELETED &cMacro G;(G<(G (G8( %C  G)(G)( % C G( 1% CsolutionbUC  = T-UCMACROTHISCTALKCDELETEDCPOINTCSEPCDATE CCURRENCY RESTOREHELPCOLDPATHAUTOSETDEFAULT CDIRECTORYLCALLEDBYSOLUTIONSOLUTIONSHOWTHISFORMVISIBLEe)%C SOLUTIONS.CCttFTaTaT% T T CPATHv G)(TC %CCQ TCQTCQSamples\CCLASSES CSOLUTION C TCDEFAULTvC% G(TCPOINTvTC SEPARATORvTCDATEvTCCURRENCYvTCTALKvTCDELETEDv G;(. G<(,G (AMERICAN G8($G G2ULCDIR LCSAMPLEPATHSLCHOMETHISLCALLEDBYSOLUTIONTHISFORMSHOWTIPS AUTOCENTER CENTERFORMFIXEDFORMBORDER BORDERSTYLECOLDPATH GETDIRECTORY ADDTOPATH CDIRECTORYAUTOSETDEFAULTCPOINTCSEPCDATE CCURRENCYCTALKCDELETED getdirectory,savehelp restorehelpY addtopathDestroyInit1r1!AA3RAA31!AA3qrQbAAAAAA3Aq"AAA3A1Ab2AAsaa1aa2  , B$.=D b)  %D{U6#%C_VFP.ActiveFormbO/ CU ACTIVEFORMREFRESHP %C+7CEnabled-B TCO#) TCO#6 TCO # HI T-T-TaT a )TaTaT-T -2ICEnabledaU NRECNTOPNBOTTOMTHISSETALLCMDTOPENABLEDCMDPRIORCMDNEXT CMDBOTTOM'%C  FUTHIS SKIPTABLE!% UTHISENABLEDISABLEONINITENABLEDISABLEBUTTONS4 H  )TCDBF Select Table:Open%C0F QTCT 1TC%*R, Unable to resolve data conflict.2fT Error Number: CCZC C Error Message: CEC C  Procedure: CtT C 2x H   X2BU NERRORCMETHODNLINE CNEWTABLETHIS SKIPTABLENCONFLICTSTATUS DATACHECKER1CHECKCONFLICTSLCMSGLNANSWERrecordpointermoved,enabledisablebuttons{beforerecordpointermoved!Init]Error11A3AAQQA21A3A2A!DAfAAAAAA2a!$#<z*'9 /) %  UO%C m.lnScopebN3T %C  >R,4Invalid value passed to conflictmanager.handlerecord# T - T a%C SourceType C (C.T T C /%C bGM.T C _T C  H %   T aT C)A value has been changed by another user.C Field: C Record Number: CCCOZCC m.lcFieldbM}C C Original Value: C  C Current Value: C  C  Your change: CC  &C C   is a Memo field.6C C <Do you want to overwrite the current value with your change?C 0(Choose 'Cancel' to restore the original value.)3 Data Conflictx T C $%      T aT CA value has been changed.C Field:  C Record Number: CCCOZCC m.lcFieldbM}C C Original Value: C  C Current Value: C  C  Your change: CC  &C C   is a Memo field.6C C <Do you want to overwrite the current value with your change?C 0(Choose 'Cancel' to restore the original value.)3Verify Changesx H >   >  % 7T C-aBC 6H BU LNSCOPELNCHOICELNFIELDLCFIELDLUOLDVALLUCURVALLUFIELD LLMADECHANGE LLSUCCESSTHISSTRING T C m.luValueb H. CO BC  C NYwBCC Z D BC * TBC m.luValue LBC .T..F.6 MB Memo fieldULUVALUEUTYPE T -T  H8! CC Buffering%2C| T a! CC Buffering%C T a2 R,:% yET C!Do you want to save your changes?$ Save Changesx% cT CCaa6u Ca B ULNCHOICE LLMADECHANGE LNSUCCESS NOBUFF_LOC1 T  H'! CC Bufferingx%2CtT C! CC Buffering T C+  # *T C  C6T C 2 R,: B U LNSUCCESSLNRECTHIS HANDLERECORD NOBUFF_LOC1 T  H'! CC Bufferingx%2CtT C! CC Buffering T C+  # *T C  C6T C 2 R,: B U LNSUCCESSLLNRECTHIS HANDLERECORD NOBUFF_LOC handlerecord,string verifychangesverifyeachchange checkconflictsA 1AA1A2aAAAA2QVA21AAA1A1AAAA3zAAAQA!1A2 aAAAAQ1AA2aaA!AAAA2aaA!AAAA12WiC{K]r%pJ!)    J%7Y KUh%C%CINITIALIZE_AND_ADJUSTT-aCADJUSTUTHIS INITIALRESIZELOOPTHROUGHCONTROLSTC&T &T &T &T  ETCCoControl.FontSizebU 6U OCONTROLNLENTHIS ACONTROLSTATSTOPINITIALFORMHEIGHTLEFTINITIALFORMWIDTHHEIGHTWIDTHFONTSIZEz "TC$%Textbox Spinner s"TCUOCONTROLNPOSWIDTHTHISFORMTHIS ACONTROLSTATS BASECLASSHEIGHTTCfTCDECIMALv G ( TTa (|TC T&%INITIALIZE_AND_ADJUSTC % C % -C '%C  Pageframex& (C t!C C p (lT&%INITIALIZE_AND_ADJUSTCC  % 8C % hC T- G (UCTASK NOLDDECIMALNPOSTHISFORM LOCKSCREENI CONTROLCOUNTOCONTROLCONTROLSTHIS ADDTOARRAYCLASS RESIZELISTSETSIZEREPOSITIONLIST SETPOSITION BASECLASSJ PAGECOUNTPAGESKMTaTTUTHIS INITIALRESIZE ACONTROLSTATSINITIALFORMHEIGHTTHISFORMHEIGHTINITIALFORMWIDTHWIDTHR "TC"TCU OCONTROLNPOSTOPTHISFORMHEIGHTTHIS ACONTROLSTATSLEFTWIDTH)TTUTHISINITIALFORMHEIGHTTHISFORMHEIGHTINITIALFORMWIDTHWIDTHadjustcontrols, addtoarraysetsizeJloopthroughcontrolsresett setposition'Init1QaA2qQaaaaQ3!A!A4qbqaAqQAqQAsbaAqQAqQAAAAAA2a113!!3111 ? ND K VHf \)  PROCEDURE getdirectory * Return the directory name from a file LPARAMETERS lcFile IF TYPE("lcFile") = "L" && No parameter passed in IF TYPE("THISFORM") = "O" lcFile = SYS(1271, THISFORM) ELSE lcFile = SYS(16,1) ENDIF ENDIF RETURN JUSTPATH(lcFile) ENDPROC PROCEDURE savehelp *IF !"SOLUTION" $ UPPER(SET("HELP",1)) THEN IF !UPPER(JUSTSTEM(THIS.cHelpFile)) $ UPPER(SET("HELP",1)) THEN THIS.cOldHelp = SET("HELP",1) ENDIF IF !EMPTY(THIS.cHelpFile) AND FILE(THIS.cHelpFile) THEN SET HELP TO (THIS.cHelpFile) ENDIF ENDPROC PROCEDURE restorehelp IF !EMPTY(THIS.cOldHelp) IF FILE(THIS.cOldHelp) SET HELP TO (THIS.cOldHelp) ELSE SET HELP TO EVAL(THIS.cOldHelp) ENDIF ENDIF ENDPROC PROCEDURE addtopath LPARAMETER tcPath LOCAL lcPath tcPath = ALLTRIM(tcPath) lcSetPath = ALLTRIM(SET("PATH")) IF ATC(tcPath,lcSetPath)#0 DO CASE CASE ATC(tcPath+";",lcSetPath)#0 RETURN CASE ATC(ADDBS(tcPath)+";",lcSetPath)#0 RETURN CASE ATC(RIGHT(lcSetPath,LEN(tcPath)),tcPath)#0 RETURN ENDCASE ENDIF IF EMPTY(lcSetPath) SET PATH TO (tcPath) ELSE SET PATH TO (lcSetPath + IIF(RIGHT(lcSetPath,1)=";","",";") + tcPath) ENDIF ENDPROC PROCEDURE Destroy * Restore old SET settings. This isn't necessary for forms * with a Private DataSession cMacro = THIS.cTalk SET TALK &cMacro cMacro = THIS.cDeleted SET DELETED &cMacro SET POINT TO THIS.cPoint SET SEPARATOR TO THIS.cSep SET DATE TO (THIS.cDate) SET CURRENCY TO THIS.cCurrency THIS.restoreHelp IF EMPTY(THIS.cOldPath) SET PATH TO ELSE SET PATH TO (THIS.cOldPath) ENDIF IF THIS.AutoSETDEFAULT AND !EMPTY(THIS.cDirectory) SET DEFAULT TO (THIS.cDirectory) ENDIF * If this form is run from the solutions form, * the hidden form object, solutions, is made visible when * this control is destroyed. IF THIS.lCalledBySolution AND NOT (TYPE('solution')='U' OR ISNULL(solution)) Solution.Show THISFORM.Visible = .F. ENDIF ENDPROC PROCEDURE Init #define POINT_LOC "." #define SEP_LOC "," #define DATE_LOC "AMERICAN" #define CURRENCY_LOC "$" *----------------------< c_solutions >-----------------------* * This class is added to all forms in the Solutions * sample suite. *---------------------------------------------------------* LOCAL lcDir, lcSamplePaths, lcHome IF ATC("SOLUTIONS.",PROG(PROG(-1)-1))#0 THIS.lCalledBySolution = .T. ENDIF THISFORM.ShowTips = .T. THISFORM.AutoCenter = This.CenterForm IF THIS.FixedFormBorder THISFORM.BorderStyle = 2 && Fixed Dialog ENDIF THIS.cOldPath = SET("PATH") SET PATH TO lcDir= THIS.GetDirectory() &&directory of sample IF !EMPTY(HOME(2)) lcHome = HOME(2) ELSE lcHome = HOME()+"Samples\" ENDIF THIS.AddToPath(lcHome+"CLASSES") THIS.AddToPath(lcHome+"SOLUTION") THIS.AddToPath(lcDir) THIS.cDirectory = SET("DEFAULT") + CURDIR() IF THIS.AutoSETDEFAULT SET DEFAULT TO (lcDir) ENDIF * Save old settings to be restored. THIS.cPoint = SET("POINT") THIS.cSep = SET("SEPARATOR") THIS.cDate = SET("DATE") THIS.cCurrency = SET("CURRENCY", 1) THIS.cTalk = SET("TALK") THIS.cDeleted = SET("DELETED") SET POINT TO POINT_LOC SET SEPARATOR TO SEP_LOC SET DATE TO DATE_LOC SET CURRENCY TO CURRENCY_LOC SET DELETED ON && ignore records marked for deletion SET TALK OFF ENDPROC ^ EEig%2HUTCTCCPATHv%C HU C;tB CC;B CCC>RB%C G)(-G)(CCR;;6UTCPATHLCPATH LCSETPATH[!CfontnameTahomaCfontsizeTCCC]UTHISSETALLTHISFORMCRUNPATH%zTCPATHvCCQFFCCCQWIZARDSCCQGALLERYUTHIS LSETFFCPATH LCFFCPATH CSAVESETPATH ADDTOPATHC/%CTHIS.c_solutions1.BaseclassbC< UTHIS C_SOLUTIONS1 RESTOREHELPC/%CTHIS.c_solutions1.BaseclassbC< UTHIS C_SOLUTIONS1SAVEHELPSG&(%L%C1 G)(HG)(UTHIS LSETFFCPATH CSAVESETPATH addtopath,InitaLoad DeactivateActivateUnloadk1qrQbAAAAAA33qaqA2A3A3a!AA2a|/ !P)%/)/5)EPROCEDURE addtopath LPARAMETER tcPath LOCAL lcPath tcPath = ALLTRIM(tcPath) lcSetPath = ALLTRIM(SET("PATH")) IF ATC(tcPath,lcSetPath)#0 DO CASE CASE ATC(tcPath+";",lcSetPath)#0 RETURN CASE ATC(ADDBS(tcPath)+";",lcSetPath)#0 RETURN CASE ATC(RIGHT(lcSetPath,LEN(tcPath)),tcPath)#0 RETURN ENDCASE ENDIF IF EMPTY(lcSetPath) SET PATH TO (tcPath) ELSE SET PATH TO (lcSetPath + IIF(RIGHT(lcSetPath,1)=";","",";") + tcPath) ENDIF ENDPROC PROCEDURE Init this.setall('fontname', 'Tahoma') this.setall('fontsize',8) Thisform.cRunPath = ADDBS(JUSTPATH(SYS(1271, thisform))) ENDPROC PROCEDURE Load IF THIS.lSetFFCPath LOCAL lcFFCPath THIS.cSaveSetPath = SET("PATH") THIS.AddToPath(HOME()+"FFC") THIS.AddToPath(HOME()+"WIZARDS") THIS.AddToPath(HOME()+"GALLERY") ENDIF ENDPROC PROCEDURE Deactivate IF TYPE("THIS.c_solutions1.Baseclass")="C" THIS.c_solutions1.restoreHelp ENDIF ENDPROC PROCEDURE Activate IF TYPE("THIS.c_solutions1.Baseclass")="C" THIS.c_solutions1.saveHelp ENDIF ENDPROC PROCEDURE Unload SET MESSAGE TO IF THIS.lSetFFCPath IF EMPTY(THIS.cSaveSetPath) SET PATH TO ELSE SET PATH TO (THIS.cSaveSetPath) ENDIF ENDIF ENDPROC